home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-alloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-10-17  |  13.5 KB  |  609 lines
  1. /*  pl-alloc.c,v 1.18 1995/02/07 12:12:16 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: memory allocation
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. #ifndef ALLOC_DEBUG
  13. #define ALLOC_DEBUG 0
  14. #endif
  15. #define ALLOC_MAGIC 0xbf
  16. #define ALLOC_FREE_MAGIC 0x5f
  17.  
  18. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  19. This module defines memory allocation for the heap (the  program  space)
  20. and  the  various  stacks.   Memory  allocation below ALLOCFAST bytes is
  21. based entirely on a perfect fit algorithm.  Above ALLOCFAST  the  system
  22. memory  allocation  function  (typically malloc() is used to optimise on
  23. space.  Perfect fit memory allocation is fast and because  most  of  the
  24. memory  is allocated in small segments and these segments normally occur
  25. in similar relative frequencies it does not waste much memory.
  26.  
  27. The prolog machinery using these memory allocation functions always know
  28. how  much  memory  is  allocated  and  provides  this  argument  to  the
  29. corresponding  unalloc()  call if memory need to be freed.  This saves a
  30. word to store the size of the memory segment.
  31. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  32.  
  33. typedef struct chunk *    Chunk;
  34. #ifndef ALIGN_SIZE
  35. #if defined(__sgi) && !defined(__GNUC__)
  36. #define ALIGN_SIZE sizeof(double)
  37. #else
  38. #define ALIGN_SIZE sizeof(long)
  39. #endif
  40. #endif
  41. #define ALLOC_MIN  sizeof(Chunk)
  42.  
  43. struct chunk
  44. { Chunk        next;        /* next of chain */
  45. };
  46.  
  47. forwards Chunk    allocate(alloc_t size);
  48.  
  49. static char   *spaceptr;    /* alloc: pointer to first free byte */
  50. static alloc_t spacefree;    /* number of free bytes left */
  51.  
  52. static Chunk  freeChains[ALLOCFAST/sizeof(Chunk)+1];
  53.  
  54. #define ALLOCROUND(n) ROUND(n, ALIGN_SIZE)
  55.                
  56. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  57. Allocate n bytes from the heap.  The amount returned is n rounded up to
  58. a multiple of words.  Allocated memory always starts at a word boundary.
  59.  
  60. below ALLOCFAST we use a special purpose fast allocation scheme.  Above
  61. (which is very rare) we use Unix malloc()/free() mechanism.
  62.  
  63. The rest of the code uses the macro allocHeap() to access this function
  64. to avoid problems with 16-bit machines not supporting an ANSI compiler.
  65. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  66.  
  67. void *
  68. alloc_heap(size_t n)
  69. { register Chunk f;
  70.   register alloc_t m;
  71.   
  72.   if ( n == 0 )
  73.     return NULL;
  74.  
  75.   DEBUG(9, Sdprintf("allocated %ld bytes at ", (unsigned long)n));
  76.   n = ALLOCROUND(n);
  77.   GD->statistics.heap += n;
  78.  
  79.   if (n <= ALLOCFAST)
  80.   { m = n / (int) ALIGN_SIZE;
  81.     if ((f = freeChains[m]) != NULL)
  82.     { freeChains[m] = f->next;
  83.       f->next = (Chunk) NULL;
  84.       DEBUG(9, Sdprintf("(r) %ld (0x%lx)\n",
  85.               (unsigned long) f, (unsigned long) f));
  86. #if ALLOC_DEBUG
  87.       { int i;
  88.     char *s = (char *) f;
  89.  
  90.     for(i=sizeof(struct chunk); i<n; i++)
  91.       assert(s[i] == ALLOC_FREE_MAGIC);
  92.  
  93.     memset((char *) f, ALLOC_MAGIC, n);
  94.       }
  95. #endif
  96.       return (Word) f;            /* perfect fit */
  97.     }
  98.     f = allocate(n);            /* allocate from core */
  99.  
  100.     SetHBase(f);
  101.     SetHTop((char *)f + n);
  102.  
  103.     DEBUG(9, Sdprintf("(n) %ld (0x%lx)\n", (unsigned long)f, (unsigned long)f));
  104. #if ALLOC_DEBUG
  105.     memset((char *) f, ALLOC_MAGIC, n);
  106. #endif
  107.     return f;
  108.   }
  109.  
  110.   if ( (f = malloc(n)) == NULL )
  111.     outOfCore();
  112.  
  113.   SetHBase(f);
  114.   SetHTop((char *)f + n);
  115.  
  116.   DEBUG(9, Sdprintf("(b) %ld\n", (unsigned long)f));
  117. #if ALLOC_DEBUG
  118.   memset((char *) f, ALLOC_MAGIC, n);
  119. #endif
  120.   return f;
  121. }
  122.  
  123. void
  124. free_heap(void *mem, size_t n)
  125. { Chunk p = (Chunk) mem;
  126.  
  127.   if ( mem == NULL )
  128.     return;
  129.  
  130.   n = ALLOCROUND(n);
  131. #if ALLOC_DEBUG
  132.   memset((char *) mem, ALLOC_FREE_MAGIC, n);
  133. #endif
  134.   GD->statistics.heap -= n;
  135.   DEBUG(9, Sdprintf("freed %ld bytes at %ld\n",
  136.             (unsigned long)n, (unsigned long)p));
  137.  
  138.   if (n <= ALLOCFAST)
  139.   { n /= ALIGN_SIZE;
  140.     p->next = freeChains[n];
  141.     freeChains[n] = p;
  142.   } else
  143.   { free(p);
  144.   }
  145. }
  146.  
  147. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  148. No perfect fit is available.  We pick memory from the big chunk  we  are
  149. working  on.   If this is not big enough we will free the remaining part
  150. of it.  Next we check whether any areas are  assigned  to  be  used  for
  151. allocation.   If  all  this fails we allocate new core using Allocate(),
  152. which normally calls malloc(). Early  versions  of  this  module  called
  153. sbrk(),  but  many systems get very upset by using sbrk() in combination
  154. with other memory allocation functions.
  155. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  156.  
  157. static
  158. Chunk
  159. allocate(register size_t n)
  160. { char *p;
  161.  
  162.   if (n <= spacefree)
  163.   { p = spaceptr;
  164.     spaceptr += n;
  165.     spacefree -= n;
  166.     return (Chunk) p;
  167.   }
  168.  
  169.   if ( spacefree >= sizeof(struct chunk) )
  170.     freeHeap(spaceptr, (alloc_t) (spacefree/ALIGN_SIZE)*ALIGN_SIZE);
  171.  
  172.   if ((p = (char *) Allocate(ALLOCSIZE)) <= (char *)NULL)
  173.     outOfCore();
  174.  
  175.   spacefree = ALLOCSIZE;
  176.   spaceptr = p + n;
  177.   spacefree -= n;
  178.  
  179.   return (Chunk) p;
  180. }
  181.  
  182. void
  183. initMemAlloc()
  184. { assert(ALIGN_SIZE >= ALLOC_MIN);
  185.  
  186.   if ( !GD->dumped )
  187.   { hBase = (char *)(~0L);
  188.     hTop  = (char *)NULL;
  189.   }
  190.   { void *hbase = allocHeap(sizeof(word));
  191.  
  192.     heap_base = (ulong)hbase & ~0x007fffffL; /* 8MB */
  193.     freeHeap(hbase, sizeof(word));
  194.   }
  195. }
  196.         /********************************
  197.         *             STACKS            *
  198.         *********************************/
  199.  
  200. volatile void
  201. outOf(Stack s)
  202. { LD->outofstack = TRUE;        /* will be reset by abort() */
  203.  
  204.   warning("Out of %s stack", s->name);
  205.  
  206.   pl_abort();
  207.   exit(2);                /* should not happen */
  208. }
  209.  
  210.  
  211. volatile void
  212. outOfCore()
  213. { fatalError("Could not allocate memory: %s", OsError());
  214. }
  215.  
  216.          /*******************************
  217.          *    REFS AND POINTERS    *
  218.          *******************************/
  219.  
  220. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  221. __consPtr() is inlined for this module (including pl-wam.c), but external
  222. for the other modules, where it is far less fime-critical.
  223. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  224.  
  225. #if !defined(consPtr) || defined(SECURE_GC)
  226. #undef consPtr
  227.  
  228. static inline word
  229. __consPtr(void *p, int ts)
  230. { unsigned long v = (unsigned long) p;
  231.  
  232.   v -= base_addresses[ts&STG_MASK];
  233.   assert(v < MAXTAGGEDPTR);
  234.   return (v<<5)|ts;
  235. }
  236.  
  237. word
  238. consPtr(void *p, int ts)
  239. { return __consPtr(p, ts);
  240. }
  241.  
  242. #define consPtr(p, s) __consPtr(p, s)
  243. #endif
  244.  
  245. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  246. makeRef() and makeRefLG(). Make  a   reference  pointer. The makeRefLG()
  247. version is used by the WAM-interpreter to  exploit the fact that we know
  248. the pointer is either to the local or global stack.
  249.  
  250. This was designed while terms could  also   live  on the permanent heap.
  251. This is no longer the case, but  we   still  keep  makeRef() as a public
  252. function, rather then an inlined function.
  253. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  254.  
  255. static inline word
  256. makeRefLG(Word p)
  257. { if ( p >= (Word) lBase )
  258.     return consPtr(p, TAG_REFERENCE|STG_LOCAL);
  259.   else
  260.     return consPtr(p, TAG_REFERENCE|STG_GLOBAL);
  261. }
  262.  
  263.  
  264. word
  265. makeRef(Word p)
  266. { return makeRefLG(p);            /* public version */
  267. }
  268.  
  269.         /********************************
  270.         *        GLOBAL STACK           *
  271.         *********************************/
  272.  
  273. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  274. alloc_global() allocates on the global stack.  Many  functions  do  this
  275. inline  as  it is simple and usualy very time critical.  The rest of the
  276. system should call the macro allocGlobal() to ensure the type  is  right
  277. on 16-bit machines not supporting ANSI.
  278. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  279.  
  280. #if O_SHIFT_STACKS
  281. void *
  282. alloc_global(int n)
  283. { Word result;
  284.  
  285.   if ( roomStack(global)/sizeof(word) < (long) n )
  286.   { growStacks(NULL, NULL, FALSE, TRUE, FALSE);
  287.  
  288.     if ( roomStack(global)/sizeof(word) < (long) n )
  289.       outOf((Stack) &LD->stacks.global);
  290.   }
  291.  
  292.   result = gTop;
  293.   gTop += n;
  294.  
  295.   return result;
  296. }
  297.  
  298. #else
  299.  
  300. void *
  301. alloc_global(int n)
  302. { Word result = gTop;
  303.  
  304.   requireStack(global, n * sizeof(word));
  305.   gTop += n;
  306.  
  307.   return result;
  308. }
  309.  
  310. #endif
  311.  
  312. word
  313. globalFunctor(functor_t f)
  314. { int arity = arityFunctor(f);
  315.   Functor t = allocGlobal(1 + arity);
  316.   Word a;
  317.  
  318.   t->definition = f;
  319.   for(a = &t->arguments[0]; arity > 0; a++, arity--)
  320.     setVar(*a);
  321.  
  322.   return consPtr(t, TAG_COMPOUND|STG_GLOBAL);
  323. }
  324.  
  325.  
  326. Word
  327. newTerm(void)
  328. { Word t = allocGlobal(1);
  329.  
  330.   setVar(*t);
  331.  
  332.   return t;
  333. }
  334.  
  335.          /*******************************
  336.          *      OPERATIONS ON LONGS    *
  337.          *******************************/
  338.  
  339. word
  340. globalLong(long l)
  341. { Word p = allocGlobal(3);
  342.   word r = consPtr(p, TAG_INTEGER|STG_GLOBAL);
  343.   word m = mkIndHdr(1, TAG_INTEGER);
  344.  
  345.   *p++ = m;
  346.   *p++ = l;
  347.   *p   = m;
  348.   
  349.   return r;
  350. }
  351.  
  352.  
  353.          /*******************************
  354.          *    OPERATIONS ON STRINGS    *
  355.          *******************************/
  356.  
  357. int
  358. sizeString(word w)
  359. { word m  = *((Word)addressIndirect(w));
  360.   int wn  = wsizeofInd(m);
  361.   int pad = padHdr(m);
  362.  
  363.   return wn*sizeof(word) - pad;
  364. }
  365.  
  366.  
  367. word
  368. globalNString(long l, const char *s)
  369. { int lw = (l+sizeof(word))/sizeof(word);
  370.   int pad = (lw*sizeof(word) - l);
  371.   Word p = allocGlobal(2 + lw);
  372.   word r = consPtr(p, TAG_STRING|STG_GLOBAL);
  373.   word m = mkStrHdr(lw, pad);
  374.  
  375.   *p++ = m;
  376.   p[lw-1] = 0L;                /* write zero's for padding */
  377.   memcpy(p, s, l);
  378.   p += lw;
  379.   *p = m;
  380.   
  381.   return r;
  382. }
  383.  
  384.  
  385. word
  386. globalString(const char *s)
  387. { return globalNString(strlen(s), s);
  388. }
  389.  
  390.  
  391.  
  392.          /*******************************
  393.          *     OPERATIONS ON DOUBLES    *
  394.          *******************************/
  395.  
  396. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  397. Storage of floats (doubles) on the  stacks   and  heap.  Such values are
  398. packed into two `guards words'.  An   intermediate  structure is used to
  399. ensure the possibility of  word-aligned  copy   of  the  data. Structure
  400. assignment is used here  to  avoid  a   loop  for  different  values  of
  401. WORDS_PER_DOUBLE.
  402. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  403.  
  404. #define WORDS_PER_DOUBLE ((sizeof(double)+sizeof(word)-1)/sizeof(word))
  405.  
  406. typedef struct
  407. { word w[WORDS_PER_DOUBLE];
  408. } fword;
  409.  
  410. double                    /* take care of alignment! */
  411. valReal(word w)
  412. { fword *v = (fword *)valIndirectP(w);
  413.   union
  414.   { double d;
  415.     fword  l;
  416.   } val;
  417.   
  418.   val.l = *v;
  419.  
  420.   return val.d;
  421. }
  422.  
  423.  
  424. word
  425. globalReal(double d)
  426. { Word p = allocGlobal(2+WORDS_PER_DOUBLE);
  427.   word r = consPtr(p, TAG_FLOAT|STG_GLOBAL);
  428.   word m = mkIndHdr(WORDS_PER_DOUBLE, TAG_FLOAT);
  429.   union
  430.   { double d;
  431.     fword  l;
  432.   } val;
  433.   fword *v;
  434.  
  435.   val.d = d;
  436.   *p++ = m;
  437.   v = (fword *)p;
  438.   *v++ = val.l;
  439.   p = (Word) v;
  440.   *p   = m;
  441.  
  442.   return r;
  443. }
  444.  
  445.  
  446.          /*******************************
  447.          *  GENERIC INDIRECT OPERATIONS    *
  448.          *******************************/
  449.  
  450. int
  451. equalIndirect(word w1, word w2)
  452. { Word p1 = addressIndirect(w1);
  453.   Word p2 = addressIndirect(w2);
  454.   
  455.   if ( *p1 == *p2 )
  456.   { int n = wsizeofInd(*p1);
  457.     
  458.     while( --n >= 0 )
  459.     { if ( *++p1 != *++p2 )
  460.     fail;
  461.     }
  462.  
  463.     succeed;
  464.   }
  465.  
  466.   fail;
  467. }
  468.  
  469.  
  470. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  471. Copy an indirect data object to the heap.  The type is not of importance,
  472. neither is the length or original location.
  473. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  474.  
  475. word
  476. globalIndirect(word w)
  477. { Word p = addressIndirect(w);
  478.   word t = *p;
  479.   int  n = wsizeofInd(t);
  480.   Word h = allocGlobal((n+2));
  481.   Word hp = h;
  482.   
  483.   *hp = t;
  484.   while(--n >= 0)
  485.     *++hp = *++p;
  486.   *++hp = t;
  487.  
  488.   return consPtr(h, tag(w)|STG_GLOBAL);
  489. }
  490.  
  491.  
  492. word
  493. globalIndirectFromCode(Code *PC)
  494. { Code pc = *PC;
  495.   word m = *pc++;
  496.   int  n = wsizeofInd(m);
  497.   Word p = allocGlobal(n+2);
  498.   word r = consPtr(p, tag(m)|STG_GLOBAL);
  499.  
  500.   *p++ = m;
  501.   while(--n >= 0)
  502.     *p++ = *pc++;
  503.   *p++ = m;
  504.  
  505.   *PC = pc;
  506.   return r;
  507. }
  508.  
  509.  
  510. static int                /* used in pl-wam.c */
  511. equalIndirectFromCode(word a, Code *PC)
  512. { Word pc = *PC;
  513.   Word pa = addressIndirect(a);
  514.  
  515.   if ( *pc == *pa )
  516.   { int  n = wsizeofInd(*pc);
  517.  
  518.     while(--n >= 0)
  519.     { if ( *++pc != *++pa )
  520.     fail;
  521.     }
  522.     pc++;
  523.     *PC = pc;
  524.     succeed;
  525.   }
  526.  
  527.   fail;
  528. }
  529.  
  530.  
  531.         /********************************
  532.         *            STRINGS            *
  533.         *********************************/
  534.  
  535. char *
  536. store_string(const char *s)
  537. { char *copy = (char *)allocHeap(strlen(s)+1);
  538.  
  539.   strcpy(copy, s);
  540.   return copy;
  541. }
  542.  
  543.  
  544. void
  545. remove_string(char *s)
  546. { if ( s )
  547.     freeHeap(s, strlen(s)+1);
  548. }
  549.  
  550.  
  551. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  552. Hash function for strings.  This function has been evaluated on Shelley,
  553. which defines about 5000 Prolog atoms.  It produces a very nice  uniform
  554. distribution over these atoms.  Note that size equals 2^n.
  555. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  556.  
  557. int
  558. unboundStringHashValue(const char *t)
  559. { unsigned int value = 0;
  560.   unsigned int shift = 5;
  561.  
  562.   while(*t)
  563.   { unsigned int c = *t++;
  564.     
  565.     c -= 'a';
  566.     value ^= c << (shift & 0xf);
  567.     shift ^= c;
  568.   }
  569.  
  570.   return value ^ (value >> 16);
  571. }
  572.  
  573.  
  574.          /*******************************
  575.          *         GNU MALLOC        *
  576.          *******************************/
  577.  
  578. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  579. These functions are used by various GNU-libraries and -when not linked
  580. with the GNU C-library lead to undefined symbols.  Therefore we define
  581. them in SWI-Prolog so that we can also give consistent warnings.
  582. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  583.  
  584. void *
  585. xmalloc(size_t size)
  586. { void *mem;
  587.  
  588.   if ( (mem = malloc(size)) )
  589.     return mem;
  590.   if ( size )
  591.     outOfCore();
  592.  
  593.   return NULL;
  594. }
  595.  
  596.  
  597. void *
  598. xrealloc(void *mem, size_t size)
  599. { void *newmem;
  600.  
  601.   newmem = mem ? realloc(mem, size) : malloc(size);
  602.   if ( newmem )
  603.     return newmem;
  604.   if ( size )
  605.     outOfCore();
  606.  
  607.   return NULL;
  608. }
  609.